perm filename CSMAIL.SAI[MNT,CSR]1 blob
sn#229921 filedate 1976-08-05 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00013 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 CSMAIL
C00007 00003 THE MAILIT PROCEDURE
C00011 00004 the CHECKS subprocedure
C00015 00005 the MAKELS subprocedure
C00019 00006 the LABELS subprocedure
C00024 00007 more labels
C00030 00008 the INVOICE subprogram
C00034 00009 more invoice
C00036 00010 the REPORT subprocedure
C00039 00011 more REPORT subprocedure
C00042 00012 this is the execution of the program
C00044 00013 CSMAIL runs
C00049 ENDMK
C⊗;
COMMENT CSMAIL;
ENTRY;
BEGIN
INTERNAL PROCEDURE CSMAIL;
BEGIN "CSMAIL"
EXTERNAL INTEGER C1,C2,PL,COUNT,DSKCT,BRCHAR,NUMBER,JMP,REC,PG,C3,C4,C5;
EXTERNAL INTEGER LINELB,LINEST,COPIES,NOW;
EXTERNAL REAL PRICER,TAX;
EXTERNAL BOOLEAN EOF,FLAG,EF1,UP;
EXTERNAL STRING TYPEIN,STT,PAGE,LINE,HEADER,HASH,PAT;
EXTERNAL STRING ARRAY ADDRESS[0:5],HASHTB[0:NUMBER+2];
EXTERNAL PROCEDURE FINDER;
EXTERNAL PROCEDURE BILOOK;
EXTERNAL PROCEDURE SHELST;
EXTERNAL PROCEDURE SEARCH;
EXTERNAL PROCEDURE BAIL;
INTEGER I,J,K,REPORTS,ORDERS,OREC,DUM;
REAL TAXTOL;
STRING MONTH,ESTRING;
BOOLEAN ALOOK,BLOOK,CLOOK;
REQUIRE "⊂⊃" DELIMITERS;
DEFINE CRLF=⊂'15&'12⊃;
DEFINE PRT=⊂PRINT(CRLF⊃;
DEFINE PRTERR=⊂PRT,"The legal responses are:",CRLF,CRLF⊃;
DEFINE TTIN=⊂CLRBUF; TYPEIN←TTYINL(1,BRCHAR); WHILE EQU(TYPEIN[1 TO 1]," ")
DO DUM←LOP(TYPEIN);⊃;
DEFINE SCIN=⊂LINE←SCAN(PAGE,1,BRCHAR);⊃;
DEFINE PGIN=⊂USETI(C3,I); PAGE←INPUT(C3,2);
WHILE LENGTH(PAGE)<5 DO PAGE←INPUT(C3,2);⊃;
DEFINE INSERT=⊂PTOSTR(PL,ESTRING); ESTRING←'175; PTOSTR(PL,ESTRING);
STT←PTYIN(PL,4,BRCHAR); PTOSTR(PL,"1D"); STT←PTYIN(PL,4,BRCHAR);⊃;
DEFINE RET=⊂IF EQU(TYPEIN[1 TO 1],'15) THEN⊃;
DEFINE QUEST=⊂IF (EQU(TYPEIN[1 TO 1],"?")) OR (EQU(TYPEIN[1 TO 4],"HELP")) THEN BEGIN
PRTERR, " ?<cr> WILL PRINT YOUR OPTIONS",CRLF,
" HELP<cr> WILL PROVIDE SOME HELP",CRLF,
" <cr> "⊃;
DEFINE HELP=⊂PRT,
"HELP FOR THE CSMAIL PROGRAM: ",CRLF,
" This program will produce the invoices and mailing labels ",CRLF,
"for the monthly orders of CS REPORTS. It uses the open order file",CRLF,
"and current inventory (which you will have the opportunity to ",CRLF,
"update) to fill the orders on a first come first serve basis.",CRLF,crlf,
" The labels and invoices are output in the same order, and ",CRLF,
"in zip code order. They will be written into files called LABELS",CRLF,
"and INVOIC and can be listed at your convenience, be sure to ",CRLF,
"delete the files after they have been listed. ",CRLF,
" Finally a summary of the processing, billing and charges ",CRLF,
"will be output. ");⊃;
DEFINE ENTNUM=⊂TTIN; IF (TYPEIN<'60) OR (TYPEIN>'71) THEN BEGIN
PRT,"ERROR ON INPUT"); CONTINUE; END ELSE I←CVD(TYPEIN[1 TO (LENGTH(TYPEIN)-1)]);⊃;
COMMENT Obtain a pseudo teletype to use when writting on
the address file;
DEFINE ETVIN=⊂PL←PTYGET;
PTOSTR(PL,"L USE.CSR"&'15&'12);
STT←PTYIN(PL,5,BRCHAR);
I←'4226000000; PTYSTL(PL,I);⊃;
DEFINE ETVOUT=⊂PTOSTR(PL,"K"&'15&'12);
STT←PTYIN(PL,10,BRCHAR);⊃;
COMMENT THE MAILIT PROCEDURE;
PROCEDURE MAILIT;
BEGIN "MAILIT"
COMMENT This is the control procedure that is used to set up
the array declarations for the transfer tables, and data
tables that will be used during the processing. MAILIT
calls the following subp-rocedures to do this processing:
1. CHECKS Displays the current inventory
levels, and allows the operator
to update them so that the program
can make the correct `sales'.
2. MAKELS Builds the LIKEHASH array. This is
in zip code order with the individual
orders and hash codes. Each entry
consists of a hash code and a string
of digits - one digit for each report
used as follows:
0 - report not ordered.
1 - report ordered, and in stock.
2 - report orderd , and out of stock .
3. LABELS Produces the mailing labels in zipcode
order for listing on AVERY labels.
FILE=LABELS
4. INVOICE Produces the invoices to be listed on
the XGP or with special forms of the
line printer. FILE=INVOICES.
5. REPORTS Outputs summary data on the orders
FILE=INVOICES;
COMMENT LIKEHASH will be used to hold the hashtb while the hash entries for
those who ordered reports are put in hashtb for sorting. It will also
also be used to hold the address, and order data.
TITLES is used to access the titles of the reports;
STRING ARRAY LIKEHASH[1:NUMBER+1,0:7],TITLES[1:REPORTS+1];
INTEGER LIKENUM;
COMMENT REP[X,1] holds the stock levels.
REP[x,2] holds the order levels.
LOCATE[X,1] is the record number of an addressee.
LOCATE[X,2] is the line number of the record;
INTEGER ARRAY REP[1:REPORTS,1:2],LOCATE[1:ORDERS,1:2];
COMMENT PRICES[X] IS FOR THE PRICES OF THE REPORTS;
REAL ARRAY PRICES[1:REPORTS];
STRING INACTIVE,SAVERP;
DEFINE CALIF=⊂IF (CVD(LIKEHASH[I,1][3 TO 7])<96699)
AND (CVD(LIKEHASH[I,1][3 TO 7])>90000)
AND (EQU(LIKEHASH[I,1][2 TO 2]," ")) THEN⊃;
COMMENT the CHECKS subprocedure;
SIMPLE PROCEDURE CHECKS;
BEGIN
COMMENT This procedure is designed to update the stock levels that
were input when the REPT.DSK file was built. Once these
have been approved the stock levels will be used to produce
the invoices;
COMMENT Upon entry STT holds this months report information fron the order file;
SETFORMAT(-8,3);
LINE←SCAN(STT,1,BRCHAR); SAVERP←"";
COMMENT set up the data tables;
FOR I←1 STEP 1 UNTIL REPORTS/2 DO
BEGIN
LINE←SCAN(STT,1,BRCHAR); SAVERP←SAVERP&LINE&'12;
TITLES[2*I]←TITLES[(2*I)-1]←SCAN(LINE,8,BRCHAR);
TYPEIN←LINE[13 TO 17]&'12;
PRICES[(I*2)-1]←REALSCAN(TYPEIN,BRCHAR);
IF EQU(LINE[3 TO 6],"NONO") THEN REP[(2*I)-1,1]←10000 ELSE REP[(2*I)-1,1]←CVD(LINE[3 TO 6]);
IF EQU(LINE[21 TO 24],"NONO") THEN REP[2*I,1]←10000 ELSE REP[2*I,1]←CVD(LINE[21 TO 24]);
END;
COMMENT this loop will display the levels;
WHILE ALOOK DO
BEGIN
PRT,"The current stock is:");
FOR I←1 STEP 1 UNTIL REPORTS DO
BEGIN
SETFORMAT(8,2);
STT←CVS(REP[I,1]); IF REP[I,1]=10000 THEN STT←"NO LIMIT";
LINE←TITLES[I]; DO LINE←LINE&" " UNTIL LENGTH(LINE)≥28;
PRT,I,". ",LINE," ",STT," COPIES");
IF (I MOD 2)=0 THEN PRINT(" MICROFICHE");
SETFORMAT(-4,2);
END;
COMMENT this is the loop to allow changes to the stock levels;
WHILE BLOOK DO
BEGIN
PRT,CRLF,"Are there any changes? (Y,N,STOCK)*"); TTIN;
IF EQU(TYPEIN[1 TO 1],"N") THEN RETURN;
IF EQU(TYPEIN[1 TO 1],"?") THEN
BEGIN
PRTERR, " Y<cr> Will allow you to change inventory",crlf,
" N<cr> Will use the displayed inventory to fill orders",crlf,
" STOCK<cr> Will display the inventory again.");
CONTINUE;
END;
IF EQU(TYPEIN[1 TO 1],"Y") THEN
BEGIN
PRT,"Report display number *"); ENTNUM; J←I;
IF J>REPORTS THEN
BEGIN
PRT,"ERROR - REPORT ",J," WAS NOT OFFERED. ENTER DECIMAL DISPLAY NUMBER");
CONTINUE;
END;
PRT,"Number available *"); ENTNUM;
REP[J,1]←I;
END;
IF EQU(TYPEIN[1 TO 5],"STOCK") THEN DONE;
END;
END;
END;
COMMENT the MAKELS subprocedure;
SIMPLE PROCEDURE MAKELS;
BEGIN
COMMENT The orders will be put in the hashtb ( saving the hashtb).
Then the orders will be filled in FIFO order and the list
sorted by zip using the SHELST procedure. Finally the list
will be interchanged with likehash;
STRING LINER;
INTEGER J1;
COMMENT The hashtb ans likehash are exchanged to use the hashtb so as to be able
use the shelst to put the orders in zip order;
STT←"";
FOR I←1 STEP 1 UNTIL REPORTS DO STT←STT&"0";
LIKENUM←NUMBER;
NUMBER←ORDERS;
FOR I←1 STEP 1 UNTIL NUMBER DO LIKEHASH[I,0]←HASHTB[I];
CLOSE(C4);
LOOKUP(C4,"ORDER.DSK",FLAG); USETI(C4,OREC);
DO PAGE←INPUT(C4,2) UNTIL EQU(PAGE[1 TO 3],MONTH); CLOSE(C4);
LINE←SCAN(PAGE,1,BRCHAR);
COMMENT this is the order filling loop;
FOR I←1 STEP 1 UNTIL ORDERS DO
BEGIN
SCIN;
HASHTB[I]←LINE[2 TO 6]&STT;
J1←LENGTH(LINE)-1;
FOR J←7 STEP 1 UNTIL J1 DO
BEGIN
K←LINE[J TO J];
K←K-'60; IF K>9 THEN K←K-7;
REP[K,2]←REP[K,2]+1;
IF REP[K,1]≥REP[K,2] THEN
HASHTB[I]←HASHTB[I][1 TO K+4]&"1"&HASHTB[I][K+6 TO 38] ELSE
HASHTB[I]←HASHTB[I][1 TO K+4]&"2"&HASHTB[I][K+6 TO 38];
END;
END;
COMMENT put the list in zip code order now that orders are filled;
SHELST;
COMMENT put the hahstb back;
FOR I←1 STEP 1 UNTIL NUMBER DO
BEGIN
STT←LIKEHASH[I,0];
LIKEHASH[I,0]←HASHTB[I];
HASHTB[I]←STT;
END;
NUMBER←LIKENUM;
COMMENT put the reports into the history report file, REPTFL.DSK;
SETFORMAT(-4,2); LINER←"";
FOR I←1 STEP 1 UNTIL REPORTS/2 DO
BEGIN
LINE←SCAN(SAVERP,1,BRCHAR); LINE←LINE&'12;
STT←SCAN(LINE,8,BRCHAR); STT←STT&"|";
K←I*2-1;
J←REP[K,1]-REP[K,2]; IF J<0 THEN J←0;
IF J>8000 THEN TYPEIN←"NONO" ELSE TYPEIN←CVS(J);
LINE←LINE[1 TO 2]&TYPEIN&","&CVS(REP[K,2])&LINE[12 TO 200];
K←K+1;
J←REP[K,1]-REP[K,2]; IF J<0 THEN J←0;
IF J>8000 THEN TYPEIN←"NONO" ELSE TYPEIN←CVS(J);
LINE←LINE[1 TO 20]&TYPEIN&","&CVS(REP[K,2])&LINE[30 TO 200];
LINER←LINER&STT&LINE;
END;
CLOSE(C5); CLOSE(C4);
LOOKUP(C4,"REPTFL.DSK",FLAG); USETI(C4,0);
ENTER(C5,"REPTFL.DSK",FLAG); USETO(C5,0);
DO PAGE←INPUT(C4,2) UNTIL PAGE[1 TO 1]≤'71 AND PAGE[1 TO 1]≥'60;
SCIN; I←CVD(LINE[1 TO LENGTH(LINE)-1]);
STT←CVS(I+REPORTS/2); STT←STT&'15&'12;
IF I>0 THEN
FOR J←1 STEP 1 UNTIL I DO
BEGIN
SCIN;
STT←STT&LINE&'12;
END;
LINER←STT&LINER&'14;
OUT(C5,LINER);
END;
COMMENT the LABELS subprocedure;
SIMPLE PROCEDURE LABELS;
BEGIN
INTEGER L1,I1,I2,KT,IT,CSST;
STRING ADDER,DUMP,STA;
REAL PAYS,R1,R2;
SIMPLE PROCEDURE LABIT;
BEGIN
COMMENT this procedure assembles a label and moves it to the file,
COMMENT move in the zip code;
FOR L1←LENGTH(ADDRESS[1]) STEP 1 UNTIL 40 DO ADDRESS[1]←ADDRESS[1][1 TO L1-1]&" ";
IF ((ADDRESS[0][3 TO 3]≤'71) AND (ADDRESS[0][3 TO 3]≥'60)) THEN
BEGIN
K←5;
WHILE LENGTH(ADDRESS[K])<5 DO K←K-1;
IF K<5 THEN ADDRESS[K+1]←" "&ADDRESS[0][3 TO 7]&'15
ELSE
BEGIN
ADDRESS[K]←ADDRESS[K][1 TO LENGTH(ADDRESS[K])-1]&" ";
ADDRESS[K]←ADDRESS[K][1 TO 27]&" "&ADDRESS[0][3 TO 7]&'15;
END;
END;
COMMENT now insert the hashcode;
ADDRESS[1]←ADDRESS[1][1 TO LENGTH(ADDRESS[1])-1]&" ";
ADDRESS[1]←ADDRESS[1][1 TO 27]&" #"&ADDRESS[0][22 TO 26]&'15;
IF NOT EQU(ADDRESS[0][2 TO 2]," ") THEN
BEGIN
ADDRESS[2]←ADDRESS[2][1 TO LENGTH(ADDRESS[2])-1]&" ";
ADDRESS[2]←ADDRESS[2][1 TO 27]&" (FREE)"&'15;
END;
FOR I←1 STEP 1 UNTIL 5 DO ADDER←ADDER&ADDRESS[I]&'12;
FOR I←1 STEP 1 UNTIL LINELB-5 DO ADDER←ADDER&'15&'12;
CSST←CSST+1;
IF CSST=10 THEN
BEGIN
ADDER←ADDER[1 TO LENGTH(ADDER)-1]&'14;
CSST←0;
END;
IF LENGTH(ADDER)>8000 THEN BEGIN OUT(C4,ADDER); ADDER←""; END;
END;
COMMENT prepare the label table;
CLOSE(C4); CLOSE(C5); CLOSE(C2);
LOOKUP(C5,"LABELS",FLAG);
ENTER(C4,"LABELS",FLAG);
USETO(C4,1);
LOOKUP(C2,"ADDFIL.DSK",FLAG); USETI(C2,1);
COMMENT the leader info;
CSST←1;
ADDER←'15&'12;
FOR I←1 STEP 1 UNTIL LINEST DO ADDER←ADDER&'15&'12;
ADDER←"COMPUTER SCIENCE DEPARTMENT"&'15&'12&"LIBRARY AND PUBLICATIONS "
&"COMMITTEE"&'15&'12&MONTH&" REPORT MAILING LABELS"&'15&'12;
FOR I←1 STEP 1 UNTIL LINELB-3 DO ADDER←ADDER&'15&'12;
OUT(C4,ADDER); ADDER←"";
COMMENT now print the lables;
FOR J←1 STEP 1 UNTIL ORDERS DO
BEGIN
HASH←LIKEHASH[J,0][1 TO 5];
UP←FALSE; BILOOK;
IF UP THEN
BEGIN
PRT,HASH," HAS AN ORDER BUT IS NOT IN THE FILE.");
SEARCH;
CLOSE(C2);
LOOKUP(C2,"ADDFIL.DSK",FLAG);
IF UP THEN CONTINUE;
END;
USETI(C2,REC);
PAGE←INPUT(C2,2);
WHILE NOT EQU(PAGE[1 TO 1],"*") DO PAGE←INPUT(C2,2);
SCIN;
HEADER←LINE;
JMP←-4;
DO JMP←JMP+6 UNTIL EQU(HASH[1 TO 5],HEADER[JMP TO JMP+4]);
IF NOT EQU(HASH[1 TO 5],"#####") THEN
BEGIN
FOR IT←2 STEP 1 UNTIL JMP-1 DO SCIN;
FOR IT←1 STEP 1 UNTIL 6 DO ADDRESS[IT-1]←SCAN(PAGE,1,BRCHAR);
END;
COMMENT save the address and the location for further reference;
FOR DUM←1 STEP 1 UNTIL 6 DO LIKEHASH[J,DUM]←ADDRESS[DUM-1];
LOCATE[J,1]←REC;
LOCATE[J,2]←JMP;
COMMENT this will output the label;
LABIT;
END;
COMMENT more labels;
COMMENT this will begin of inactive customer labels;
OUT(C4,ADDER);
ADDER←'14&CRLF&"LABELS FOR INACTIVE CUSTOMERS"&CRLF&CRLF&CRLF&CRLF&CRLF;
CSST←CSST+1;
INACTIVE←""; ADDER←"";
OUT(C4,ADDER);
COMMENT exchange the hashtb and liketb to use bilook to tell if an item is
in the order list;
FOR I←1 STEP 1 UNTIL ORDERS DO
BEGIN
STT←LIKEHASH[I,0];
LIKEHASH[I,0]←HASHTB[I];
HASHTB[I]←STT;
END;
LIKENUM←NUMBER;
NUMBER←ORDERS;
COMMENT this is the section that will update the back ordering information in the
address file;
CLOSE(C2); CLOSE(C3);
LOOKUP(C2,"ADDFIL.DSK",FLAG); USETI(C2,2);
ENTER(C3,"ADDFIL.DSK",FLAG); USETO(C3,0);
KT←0;
COMMENT this will begin the update of the back order info;
WHILE NOT EF1 DO
BEGIN
DO PAGE←INPUT(C2,2) UNTIL EQU(PAGE[1 TO 1],"*") OR EF1;
KT←KT+10;
STT←SCAN(PAGE,11,BRCHAR);
WHILE ALOOK DO
BEGIN
STA←SCAN(PAGE,11,BRCHAR);
STT←STT&STA;
IF EQU(BRCHAR,'14) THEN
BEGIN
OUT(C3,STT);
DONE;
END;
LINE←SCAN(PAGE,1,BRCHAR)&'12;
IF KT=LIKENUM AND BRCHAR=0 THEN BEGIN OUT(C3,STT); DONE; END;
COMMENT this will print a label for non active addressees;
UP←FALSE; DUMP←""; HASH←LINE[21 TO 25]; BILOOK;
IF NOT UP THEN
BEGIN
I2←0; PAYS←0;
FOR I1←1 STEP 1 UNTIL REPORTS DO
BEGIN
IF NOT EQU(HASHTB[NOW][I1+5 TO I1+5],"0") THEN I2←I2+1;
IF EQU(HASHTB[NOW][I1+5 TO I1+5],"1") AND EQU(LINE[1 TO 1]," ") THEN
PAYS←PAYS+PRICES[I1];
END;
SETFORMAT(1,1);
IF I2>9 THEN STA←"M" ELSE STA←CVS(I2);
LINE←LINE[1 TO 7]&LINE[9 TO 19]&STA&LINE[20 TO 44];
COMMENT Add the amount owed to the line;
L1←33;
STA←LINE[L1-6 TO L1];
R1←REALSCAN(STA,BRCHAR);
IF EQU(LINE[L1 TO L1],"-") THEN R1←(-1)*R1;
PAYS←R1+PAYS;
SETFORMAT(-5,2);
STA←CVF(ABS(PAYS)); WHILE EQU(STA[1 TO 1]," ") DO DUM←LOP(STA);
SETFORMAT(-4,2);
IF LENGTH(STA)<6 THEN DO STA←"0"&STA UNTIL LENGTH(STA)≥6;
LINE←LINE[1 TO L1-7]&STA;
IF PAYS≥0 THEN
LINE←LINE[1 TO 32]&" "&'15&'12 ELSE
LINE←LINE[1 TO 32]&"-"&'15&'12;
END ELSE
LINE←LINE[1 TO 7]&LINE[9 TO 19]&"0"&LINE[20 TO 44];
STT←STT&LINE;
IF (CVD(LINE[8 TO 19])=0) AND (UP) AND (NOT EQU(LINE[8 TO 8],"N")) THEN
BEGIN
ADDRESS[0]←LINE;
FOR J←1 STEP 1 UNTIL 5 DO
BEGIN
ADDRESS[J]←SCAN(PAGE,1,BRCHAR)&'12;
STT←STT&ADDRESS[J];
ADDRESS[J]←ADDRESS[J][1 TO LENGTH(ADDRESS[J])-1];
END;
INACTIVE←INACTIVE&LINE[21 TO 25]&" "&ADDRESS[1]&'12;
ADDRESS[0]←"*"&ADDRESS[0];
LABIT;
END;
END;
IF KT≥LIKENUM THEN DONE;
END;
COMMENT put the hahstb back;
FOR I←1 STEP 1 UNTIL NUMBER DO
BEGIN
STT←LIKEHASH[I,0];
LIKEHASH[I,0]←HASHTB[I];
HASHTB[I]←STT;
END;
NUMBER←LIKENUM;
PRT,"The mailing labels have been printed into a file called LABELS.",CRLF,
"Labels for customers who placed orders this month are first, and",CRLF,
"those for customers who have not ordered for a year are last.",CRLF,
"The file can be listed at any time, don't forget to delete it.");
COMMENT Now use ETv to fix up the address file directory;
CLOSE(C4); CLOSE(C3); CLOSE(C2); CLOSE(C5);
ETVIN;
PTOSTR(PL,"ET ADDFIL.DSK"&'15&'12);
STT←PTYIN(PL,14,BRCHAR);
PTOSTR(PL,"YE");
STT←PTYIN(PL,5,BRCHAR);
ETVOUT;
END;
COMMENT the INVOICE subprogram;
SIMPLE PROCEDURE INVOICE;
BEGIN "INVOICE"
COMMENT this procedure will produce the invoice using the template on
page three of the data base file LBDATA;
INTEGER CTT;
BOOLEAN INSTOC,NOSTOC;
STRING SAVER,DUMP,SPACE,BACK,STR,STS,BUM;
REAL TOTAL,X,TX;
DEFINE SC8=⊂STR←SCAN(STT,8,BRCHAR);⊃;
DEFINE SC9=⊂STS←SCAN(STT,9,BRCHAR);⊃;
CLOSE(C4); LOOKUP(C4,"LBDATA.DSK",FLAG); USETI(C4,1);
DO PAGE←INPUT(C4,2) UNTIL EQU(PAGE[1 TO 6],"INVOIC");
CLOSE(C3); LOOKUP(C5,"INVOIC",FLAG); ENTER(C3,"INVOIC",FLAG); USETO(C3,1);
SAVER←""; SPACE←" "; SCIN; TAXTOL←0;
COMMENT now build the invoice;
FOR I←1 STEP 1 UNTIL ORDERS DO
BEGIN
STT←PAGE; CTT←0;
SC9; SC8;
SAVER←STS&LIKEHASH[I,2]&STR;
INSTOC←NOSTOC←FALSE;
COMMENT Determine if which of the inventory paragraphs areneeded;
FOR J←6 STEP 1 UNTIL (5+REPORTS) DO
BEGIN
IF EQU(LIKEHASH[I,0][J TO J],"1") THEN INSTOC←TRUE;
IF EQU(LIKEHASH[I,0][J TO J],"2") THEN NOSTOC←TRUE;
IF NOT EQU(LIKEHASH[I,0][J TO J],"0") THEN CTT←CTT+1;
END;
COMMENT insert the paragraph for documents we are forwarding;
IF NOT INSTOC THEN BEGIN SC8 END ELSE
BEGIN
SC9; SAVER←SAVER&STS&MONTH;
SC9; SAVER←SAVER&STS; TOTAL←0;
FOR J←6 STEP 1 UNTIL (5+REPORTS) DO
BEGIN
IF EQU(LIKEHASH[I,0][J TO J],"1") THEN
BEGIN
SAVER←SAVER&SPACE&TITLES[J-5];
IF (J MOD 2)=0 THEN
BEGIN
SAVER←SAVER&SPACE&"$"&CVF(PRICES[J-5]);
TOTAL←TOTAL+PRICES[J-5];
END;
SAVER←SAVER&'15&'12;
END; END;
CALIF TAXTOL←TAXTOL+TOTAL*TAX*(100/(100+TAX));
BUM←LIKEHASH[I,1][28 TO 33]&'15;
X←REALSCAN(BUM,BRCHAR);
X←X+TOTAL;
IF EQU(LIKEHASH[I,1][34 TO 34],"-") THEN X←(-1)*X;
IF NOT EQU(LIKEHASH[I,1][2 TO 2]," ") THEN TOTAL←X←00.00;
SC9; SC8;
SAVER←SAVER&STS&CVF(X)&STR;
END;
COMMENT more invoice;
COMMENT this section will insert the paragraph for documents that are
out of stock if any are;
IF NOT NOSTOC THEN BEGIN SC8 END ELSE
BEGIN
SC9; SAVER←SAVER&STS&MONTH;
SC9; SAVER←SAVER&STS;
FOR J←6 STEP 1 UNTIL (5+REPORTS) DO
IF EQU(LIKEHASH[I,0][J TO J],"2") THEN
SAVER←SAVER&SPACE&TITLES[J-5]&'15&'12;
SC8;
SAVER←SAVER&STR;
END;
COMMENT compute the invoice;
SC9; ESTRING←STS; SC9; BUM←STS; SC9;
CALIF SAVER←SAVER&ESTRING&MONTH&BUM&CVF(X)&" INCLUDING TAX"&STS ELSE
SAVER←SAVER&ESTRING&MONTH&BUM&CVF(X)&STS;
SAVER←SAVER[1 TO LENGTH(SAVER)-2]&" "&LIKEHASH[I,0][1 TO 5]&'15&'12;
FOR J←2 STEP 1 UNTIL 6 DO SAVER←SAVER&LIKEHASH[I,J];
SC9; BUM←STS; SC9;
SAVER←SAVER&BUM&PAT&STS&'14;
COMMENT Print out the invoice;
OUT(C3,SAVER); SAVER←"";
END;
CLOSE(C4);
END "INVOICE";
COMMENT the REPORT subprocedure;
SIMPLE PROCEDURE REPORT;
BEGIN
COMMENT this procedure adds the summary data to the back of the INVOIC
file. this data includes a summary of reports mailed with
subtotals by addressee class, and summaries of amount billed
by account;
STRING DUMP;
REAL X;
INTEGER TOT,A,N,M,F,UN;
DEFINE IFFER=⊂IF EQU(LIKEHASH[J,1][2 TO 2]⊃;
LINE←CRLF&CRLF&"SUBJECT: "&MONTH&" CS REPORT MAILING"&CRLF&CRLF; OUT(C3,LINE);
LINE←" TO: LIBRARY PUBLICATIONS COMMITTEE"&CRLF&CRLF; OUT(C3,LINE);
LINE←" FROM: "&PAT&CRLF&CRLF&CRLF; OUT(C3,LINE);
LINE←"The following is a summary of the reports that were mailed this month"&crlf&
"broken down by report and class:"; OUT(C3,LINE);
LINE←CRLF&CRLF&" REPORT NUMBER TOTAL ONF ARPA AUTO FREE UNFILLED CHARGE"&CRLF&CRLF;OUT(C3,LINE);
COMMENT this loop will tabulate the counts for each report and output it;
SETFORMAT(8,2);
FOR I←1 STEP 1 UNTIL REPORTS DO
BEGIN
A←N←M←F←UN←TOT←0;
FOR J←1 STEP 1 UNTIL ORDERS DO
BEGIN
IF EQU(LIKEHASH[J,0][I+5 TO I+5],"1") THEN
BEGIN
TOT←TOT+1;
IFFER,"A") THEN A←A+1;
IFFER,"N") THEN N←N+1;
IFFER,"M") THEN M←M+1;
IFFER,"F") THEN F←F+1;
END;
IF EQU(LIKEHASH[J,0][I+5 TO I+5],"2") THEN UN←UN+1;
END;
STT←TITLES[I];
IF (I MOD 2)=0 THEN STT←STT&" (Fiche)";
DO STT←STT&" " UNTIL LENGTH(STT)≥26;
STT←STT&CVS(TOT+UN)&CVS(N)&CVS(M)&CVS(A)&CVS(F)&CVS(UN);
IF (I MOD 2)=1 THEN
BEGIN
PRICES[I]←PRICES[I]*(TOT-A-N-M-F);
STT←STT&CVF(PRICES[I])&CRLF;
END ELSE
STT←STT&" --"&CRLF;
OUT(C3,STT);
END;
SETFORMAT(-4,2);
STT←CRLF&CRLF&"The following is the amount charged for each report broken down by account:"&CRLF&CRLF;
OUT(C3,STT);
STT←" REPORT NUMBER TOTAL ACCOUNT PERCENT SUBTOTAL"&CRLF&CRLF;
OUT(C3,STT);
COMMENT more REPORT subprocedure;
COMMENT assemble the ammounts that were charged for each report
by the account that theyare accreditable to;
DEFINE BLANKS=⊂DO STT←STT&" " UNTIL LENGTH(STT)⊃;
DEFINE INP=⊂DUMP←SCAN(LINE,13,BRCHAR)⊃;
CLOSE(C4);
LOOKUP(C4,"REPT.DSK",FLAG); USETI(C4,2);
DO PAGE←INPUT(C4,2) UNTIL EQU(PAGE[1 TO 3],MONTH);
SCIN;
SETFORMAT(7,2);
COMMENT iterate once for each report;
FOR I←1 STEP 2 UNTIL REPORTS DO
BEGIN
SCIN;
STT←SCAN(LINE,8,BRCHAR); BLANKS≥19; COMMENT STT=the report title;
DUMP←SCAN(LINE,8,BRCHAR);
DUMP←SCAN(LINE,8,BRCHAR);
STT←STT&CVF(PRICES[I]);
COMMENT add the accounting data;
WHILE ALOOK DO
BEGIN
BLANKS≥34; INP;
STT←STT&DUMP[1 TO(LENGTH(DUMP)-3)];
BLANKS≥44; ESTRING←DUMP[(LENGTH(DUMP)-1) TO LENGTH(DUMP)];
K←CVD(ESTRING)+1; ESTRING←CVS(K);
STT←STT&ESTRING; BLANKS≥59;
X←CVD(ESTRING)*0.01;
X←PRICES[I]*X;
STT←STT&CVF(X)&CRLF; OUT(C3,STT);
STT←"";
IF BRCHAR='174 THEN DONE;
END;
END;
LINE←CRLF&CRLF&"The total California tax charged was $"&CVF(TAXTOL)&CRLF;
LINE←LINE&CRLF&CRLF&"The following are the inactive accounts to whom mailing labels";
LINE←LINE&" were printed:"&CRLF&CRLF;
IF EQU(INACTIVE,"") THEN LINE←LINE&" None were printed"&CRLF ELSE
LINE←LINE&INACTIVE&'12&'12;
OUT(C3,LINE);
CLOSE(C3); CLOSE(C4); CLOSE(C5);
PRT,CRLF,CRLF,"The invoices have been written into a file called: INVOICES.");
END;
COMMENT this is the execution of the program;
CHECKS;
MAKELS;
LABELS;
INVOICE;
REPORT;
CLOSE(C2); CLOSE(C3); CLOSE(C4); CLOSE(C5);
COMMENT it is now time to update the files to indicate that the there is no
currently open report and order records;
LOOKUP(C3,"REPT.DSK",FLAG); USETI(C3,2);
ENTER(C4,"REPT.DSK",FLAG); USETO(C4,0); STT←"";
DO BEGIN DO PAGE←INPUT(C3,2) UNTIL EQU(PAGE[5 TO 7],"ENT");
IF EQU(PAGE[4 TO 4],"*") THEN PAGE←PAGE[1 TO 3]&" "&PAGE[5 TO 10000];
STT←STT&PAGE;
END
UNTIL EQU(PAGE[1 TO 3],"DEC");
OUT(C4,STT); CLOSE(C3); CLOSE(C4);
ETVIN;
PTOSTR(PL,"ET REPT.DSK"&'15&'12);
STT←PTYIN(PL,14,BRCHAR);
PTOSTR(PL,"YE");
STT←PTYIN(PL,5,BRCHAR);
LOOKUP(C3,"ORDER.DSK",FLAG); USETI(C3,2);
ENTER(C4,"ORDER.DSK",FLAG); USETO(C4,0); STT←"";
DO BEGIN DO PAGE←INPUT(C3,2) UNTIL EQU(PAGE[5 TO 7],"ORD");
IF EQU(PAGE[4 TO 4],"*") THEN PAGE←PAGE[1 TO 3]&" "&PAGE[5 TO 10000];
STT←STT&PAGE;
END
UNTIL EQU(PAGE[1 TO 3],"DEC");
OUT(C4,STT); CLOSE(C3); CLOSE(C4);
PTOSTR(PL,"ET ORDER.DSK"&'15&'12);
STT←PTYIN(PL,14,BRCHAR);
PTOSTR(PL,"YE");
STT←PTYIN(PL,5,BRCHAR);
ETVOUT;
END "MAILIT";
COMMENT CSMAIL runs;
SETBREAK(1,'12,NULL,"IKP");
SETBREAK(2,'14,NULL,"IAP");
SETBREAK(3,'15,NULL,"IAP");
SETBREAK(4,'113,NULL,"IAP");
SETBREAK(5,'136,NULL,"IAP");
SETBREAK(6,'117,NULL,"IAP");
SETBREAK(7,'54,NULL,"IAP");
SETBREAK(8,'174,NULL,"IP");
SETBREAK(9,'52,NULL,"IP");
SETBREAK(10,'56,NULL,"IP");
SETBREAK(11,'52&'14,NULL,"IAP");
SETBREAK(12,'12,NULL,"IAP");
SETBREAK(13,'54&'174,NULL,"IP");
SETBREAK(14,'77,NULL,"IAP");
ALOOK←BLOOK←CLOOK←TRUE;
COMMENT check the inventory, and determine the month to send;
WHILE ALOOK DO
BEGIN
LOOKUP(C3,"REPT.DSK",FLAG); USETI(C3,1);
DO PAGE←INPUT(C3,2) UNTIL EQU(PAGE[1 TO 3],"COM");
DO LINE←SCAN(PAGE,1,BRCHAR) UNTIL (EQU(LINE[17 TO 17],"*"))
OR (EQU(LINE[8 TO 10],"END"));
MONTH←LINE[14 TO 16];
PRT,"CSMAIL - the ",MONTH," order file will be used - OK (Y OR N) *");
TTIN; RET RETURN;
IF EQU(TYPEIN[1 TO 1],"Y") THEN DONE;
IF EQU(TYPEIN[1 TO 4],"HELP") THEN HELP;
QUEST,"WILL EXIT THE PROGRAM",CRLF,
" Y<cr> WILL CAUSE THE DISPLAYED MONTH TO BE USED",CRLF,
" N<cr> WILL ASK WHAT MONTH TO USE");
CONTINUE; END;
COMMENT this loop is only to allow the amiling of reports from other then
the current month;
WHILE BLOOK DO
BEGIN
PRT,"Enter month *"); TTIN; MONTH←TYPEIN[1 TO 3]; RET RETURN;
QUEST,"WILL EXIT THE PROGRAM",CRLF,
"MMMMM<cr> THE MONTH TO PROCESS");
IF EQU(TYPEIN[1 TO 4],"HELP") THEN HELP;
CONTINUE; END;
COMMENT check out the desired month;
CLOSE(C3); LOOKUP(C3,"REPT.DSK",FLAG); USETI(C3,1);
DO PAGE←INPUT(C3,2) UNTIL EQU(PAGE[1 TO 3],"COM");
DO LINE←SCAN(PAGE,1,BRCHAR) UNTIL EQU(LINE[14 TO 16],MONTH[1 TO 3])
OR EQU(LINE[8 TO 10],"END");
IF EQU(LINE[8 TO 10],"END") THEN
BEGIN
PRT,"ERROR - NO SUCH MONTH");
CONTINUE;
END;
DONE;
END;
DONE;
END;
COMMENT pick up the report information to pass on (stt-is the page of report
data from the file, rec-the file record number, reports-number of
reoorts);
REC←CVD(LINE[2 TO 6]); USETI(C3,REC);
REPORTS←CVD(LINE[26 TO 29])*2;
DO STT←PAGE←INPUT(C3,2) UNTIL EQU(PAGE[1 TO 3],MONTH);
COMMENT pick up the order information to pass on (record number in the file
and the number og reports);
LOOKUP(C4,"ORDER.DSK",FLAG); USETI(C4,1);
DO PAGE←INPUT(C4,2) UNTIL EQU(PAGE[1 TO 3],"COM");
DO LINE←SCAN(PAGE,1,BRCHAR) UNTIL EQU(LINE[14 TO 16],MONTH);
ORDERS←CVD(LINE[25 TO 28]);
OREC←CVD(LINE[2 TO 6]);
CLOSE(C3); CLOSE(C4);
COMMENT this is the control procedure that does it all;
MAILIT;
END "CSMAIL";
END;